home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / 19.22 / lisp / desktop.el < prev    next >
Lisp/Scheme  |  1993-10-06  |  12KB  |  350 lines
  1. ;;; desktop.el --- save partial status of Emacs when killed
  2.  
  3. ;; Copyright (C) 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Morten Welinder <terra@diku.dk>
  6. ;; Version: 2.02
  7.  
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;; Save the Desktop, i.e.,
  27. ;;    - some global variables
  28. ;;     - the list of buffers with associated files.  For each buffer also
  29. ;;        - the major mode
  30. ;;        - the default directory
  31. ;;        - the point
  32. ;;        - the mark & mark-active
  33. ;;        - buffer-read-only
  34. ;;        - truncate-lines
  35. ;;        - case-fold-search
  36. ;;        - case-replace
  37. ;;        - fill-column
  38.  
  39. ;; To use this, first put these three lines in the bottom of your .emacs
  40. ;; file (the later the better):
  41. ;;
  42. ;;    (load "desktop")
  43. ;;    (desktop-load-default)
  44. ;;    (desktop-read)
  45. ;;
  46.  
  47. ;; Start Emacs in the root directory of your "project". The desktop saver
  48. ;; is inactive by default.  You activate it by M-x desktop-save RET.  When
  49. ;; you exit the next time the above data will be saved.  This ensures that
  50. ;; all the files you were editing will be reloaded the next time you start
  51. ;; Emacs from the same directory and that points will be set where you
  52. ;; left them.
  53. ;;
  54. ;; PLEASE NOTE: The kill ring can be saved as specified by the variable
  55. ;; `desktop-globals-to-save' (by default it isn't).  This may result in saving
  56. ;; things you did not mean to keep.  Use M-x desktop-clear RET.
  57. ;;
  58. ;; Thanks to  hetrick@phys.uva.nl (Jim Hetrick)   for useful ideas.
  59. ;;            avk@rtsg.mot.com (Andrew V. Klein)  for a dired tip.
  60. ;;            chris@tecc.co.uk (Chris Boucher)    for a mark tip.
  61. ;; ---------------------------------------------------------------------------
  62. ;; TODO:
  63. ;;
  64. ;; Save window configuration.
  65. ;; Recognize more minor modes.
  66. ;; Save mark rings.
  67. ;; Start-up with buffer-menu???
  68.  
  69. ;;; Code:
  70.  
  71. ;; USER OPTIONS -- settings you might want to play with.
  72. ;; ----------------------------------------------------------------------------
  73. (defconst desktop-basefilename
  74.   (if (equal system-type 'ms-dos)
  75.       "emacs.dsk" ; Ms-Dos does not support multiple dots in file name
  76.     ".emacs.desktop")
  77.   "File for Emacs desktop.  A directory name will be prepended to this name.")
  78.  
  79. (defvar desktop-missing-file-warning t
  80.   "*If non-nil then issue warning if a file no longer exists.
  81. Otherwise simply ignore the file.")
  82.  
  83. (defvar desktop-globals-to-save
  84.   (list 'desktop-missing-file-warning
  85.     ;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
  86.     ;; 'kill-ring            
  87.     'tags-file-name
  88.     'tags-table-list
  89.     ;; 'desktop-globals-to-save    ; Itself!
  90.     ) 
  91.   "List of global variables to save when killing Emacs.")
  92.  
  93. ;; We skip .log files because they are normally temporary.
  94. ;;         (ftp) files because they require passwords and whatsnot.
  95. ;;         TAGS files to save time (tags-file-name is saved instead).
  96. (defvar desktop-buffers-not-to-save
  97.  "\\(\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
  98.  "Regexp identifying buffers that are to be excluded from saving.")
  99.  
  100. (defvar desktop-buffer-handlers
  101.   '(desktop-buffer-dired
  102.     desktop-buffer-rmail
  103.     desktop-buffer-info
  104.     desktop-buffer-file)
  105.   "*List of functions to call in order to create a buffer.  The functions are
  106. called without explicit parameters but may access the the major mode as `mam',
  107. the file name as `fn', the buffer name as `bn', the default directory as
  108. `dd'.  If some function returns non-nil no further functions are called.
  109. If the function returns t then the buffer is considered created.")
  110. ;; ----------------------------------------------------------------------------
  111. (defvar desktop-dirname nil
  112.   "The directory in which the current desktop file resides.")
  113.  
  114. (defconst desktop-header
  115. ";; --------------------------------------------------------------------------
  116. ;; Desktop File for Emacs
  117. ;; --------------------------------------------------------------------------
  118. " "*Header to place in Desktop file.")
  119. ;; ----------------------------------------------------------------------------
  120. (defconst postv18
  121.   (string-lessp "19" emacs-version)
  122.   "t if Emacs version 19 or later.")
  123.  
  124. (defun desktop-clear () "Empty the Desktop."
  125.   (interactive)
  126.   (setq kill-ring nil)
  127.   (setq kill-ring-yank-pointer nil)
  128.   (mapcar (function kill-buffer) (buffer-list)))
  129. ;; ----------------------------------------------------------------------------
  130. ;; This is a bit dirty for version 18 because that version of Emacs was not
  131. ;; toilet-trained considering hooks.
  132. (if (not (boundp 'desktop-kill))
  133.     (if postv18
  134.     (add-hook 'kill-emacs-hook 'desktop-kill)
  135.       (setq old-kill-emacs kill-emacs-hook)
  136.       (setq kill-emacs-hook
  137.         (function (lambda ()
  138.             (progn (desktop-kill)
  139.                    (if (or (null old-kill-emacs)
  140.                        (symbolp old-kill-emacs))
  141.                    (run-hooks old-kill-emacs)
  142.                  (funcall old-kill-emacs))))))))
  143. ;; ----------------------------------------------------------------------------
  144. (defun desktop-kill ()
  145.   (if desktop-dirname
  146.       (progn
  147.     (desktop-save desktop-dirname))))
  148. ;; ----------------------------------------------------------------------------
  149. (defun desktop-outvar (VAR)
  150.   "Output a setq statement for VAR to the desktop file."
  151.   (if (boundp VAR)
  152.       (progn
  153.     (insert "(setq ")
  154.     (prin1 VAR (current-buffer))
  155.     (insert " '")
  156.     (prin1 (symbol-value VAR) (current-buffer))
  157.     (insert ")\n"))))
  158. ;; ----------------------------------------------------------------------------
  159. (defun desktop-save-buffer-p (filename bufname mode)
  160.   "Return t if should record a particular buffer for next startup.
  161. FILENAME is the visited file name, BUFNAME is the buffer name, and
  162. MODE is the major mode."
  163.  
  164.   (or (and filename
  165.        (not (string-match desktop-buffers-not-to-save bufname)))
  166.       (and (null filename)
  167.        (memq mode '(Info-mode dired-mode rmail-mode)))))
  168. ;; ----------------------------------------------------------------------------
  169. (defun desktop-save (dirname)
  170.   "Save the Desktop file.  Parameter DIRNAME specifies where to save desktop."
  171.   (interactive "DDirectory to save desktop file in: ")
  172.   (save-excursion
  173.     (let ((filename (expand-file-name
  174.              (concat dirname desktop-basefilename)))
  175.       (info (nreverse
  176.          (mapcar
  177.           (function (lambda (b)
  178.                   (set-buffer b)
  179.                   (list
  180.                    (buffer-file-name)
  181.                    (buffer-name)
  182.                    (list 'quote major-mode)
  183.                    (list 'quote
  184.                      (list overwrite-mode
  185.                        (not (null
  186.                          (if postv18
  187.                              auto-fill-function
  188.                            auto-fill-hook)))))
  189.                    (point)
  190.                    (if postv18
  191.                    (list 'quote (mark t) mark-active)
  192.                  (mark))
  193.                    buffer-read-only
  194.                    truncate-lines
  195.                    fill-column
  196.                    case-fold-search
  197.                    case-replace
  198.                    (list
  199.                 'quote
  200.                 (cond ((equal major-mode 'Info-mode)
  201.                        (list Info-current-file
  202.                          Info-current-node))
  203.                       ((equal major-mode 'dired-mode)
  204.                        (if postv18
  205.                        (nreverse
  206.                         (mapcar
  207.                          (function car)
  208.                          dired-subdir-alist))
  209.                      (list default-directory)))
  210.                       ))
  211.                    )))
  212.           (buffer-list))))
  213.       (buf (get-buffer-create "*desktop*")))
  214.       (set-buffer buf)
  215.       (erase-buffer)
  216.  
  217.       (insert desktop-header
  218.           ";; Created " (current-time-string) "\n"
  219.           ";; Emacs version " emacs-version "\n\n"
  220.           ";; Global section:\n")
  221.       (mapcar (function desktop-outvar) desktop-globals-to-save)
  222.       (if (memq 'kill-ring desktop-globals-to-save)
  223.       (insert "(setq kill-ring-yank-pointer (nthcdr "
  224.           (int-to-string
  225.            (- (length kill-ring) (length kill-ring-yank-pointer)))
  226.           " kill-ring))\n"))
  227.  
  228.       (insert "\n;; Buffer section:\n")
  229.       (mapcar
  230.        (function (lambda (l)
  231.            (if (desktop-save-buffer-p
  232.             (car l)
  233.             (nth 1 l)
  234.             (nth 1 (nth 2 l)))
  235.                (progn
  236.              (insert "(desktop-buffer")
  237.              (mapcar
  238.               (function (lambda (e)
  239.                       (insert "\n  ")
  240.                       (prin1 e (current-buffer))))
  241.               l)
  242.              (insert ")\n\n")))))
  243.        info)
  244.       (setq default-directory dirname)
  245.       (if (file-exists-p filename) (delete-file filename))
  246.       (write-region (point-min) (point-max) filename nil 'nomessage)))
  247.   (setq desktop-dirname dirname))
  248. ;; ----------------------------------------------------------------------------
  249. (defun desktop-remove ()
  250.   "Delete the Desktop file and inactivate the desktop system."
  251.   (interactive)
  252.   (if desktop-dirname
  253.       (let ((filename (concat desktop-dirname desktop-basefilename)))
  254.     (if (file-exists-p filename) (delete-file filename))
  255.     (setq desktop-dirname nil))))
  256. ;; ----------------------------------------------------------------------------
  257. (defun desktop-read ()
  258.   "Read the Desktop file and the files it specifies."
  259.   (interactive)
  260.   (let ((filename))
  261.     (if (file-exists-p (concat "./" desktop-basefilename))
  262.     (setq desktop-dirname (expand-file-name "./"))
  263.       (if (file-exists-p (concat "~/" desktop-basefilename))
  264.       (setq desktop-dirname (expand-file-name "~/"))
  265.     (setq desktop-dirname nil)))
  266.     (if desktop-dirname
  267.     (progn
  268.       (load (concat desktop-dirname desktop-basefilename) t t t)
  269.       (message "Desktop loaded."))
  270.       (desktop-clear))))
  271. ;; ----------------------------------------------------------------------------
  272. (defun desktop-load-default ()
  273.   "Load the `default' start-up library manually.  Also inhibit further loading
  274. of it.  Call this from your `.emacs' file to provide correct modes for 
  275. autoloaded files."
  276.   (if (not inhibit-default-init)    ; safety check
  277.       (progn
  278.     (load "default" t t)
  279.     (setq inhibit-default-init t))))
  280. ;; ----------------------------------------------------------------------------
  281. ;; Note: the following functions use the dynamic variable binding in Lisp.
  282. ;;       The byte compiler may therefore complain of undeclared variables.
  283. ;;
  284. (defun desktop-buffer-info () "Load an info file."
  285.   (if (equal 'Info-mode mam)
  286.       (progn
  287.     (require 'info)
  288.     (Info-find-node (nth 0 misc) (nth 1 misc))
  289.     t)))
  290. ;; ----------------------------------------------------------------------------
  291. (defun desktop-buffer-rmail () "Load a RMAIL file."
  292.   (if (equal 'rmail-mode mam)
  293.       (progn (rmail-input fn) t)))
  294. ;; ----------------------------------------------------------------------------
  295. (defun desktop-buffer-dired () "Load a directory using dired."
  296.   (if (equal 'dired-mode mam)
  297.       (progn
  298.     (dired (car misc))
  299.     (mapcar (function dired-maybe-insert-subdir) (cdr misc))
  300.     t)))
  301. ;; ----------------------------------------------------------------------------
  302. (defun desktop-buffer-file () "Load a file."
  303.   (if fn
  304.       (if (or (file-exists-p fn)
  305.           (and desktop-missing-file-warning
  306.            (y-or-n-p (format
  307.                   "File \"%s\" no longer exists. Re-create? "
  308.                   fn))))
  309.       (progn (find-file fn) t)
  310.     'ignored)))
  311. ;; ----------------------------------------------------------------------------
  312. ;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
  313. ;; only.
  314. (defun desktop-buffer (fn bn mam mim pt mk ro tl fc cfs cr misc)
  315.   (let ((hlist desktop-buffer-handlers)
  316.     (result)
  317.     (handler))
  318.     (while (and (not result) hlist)
  319.       (setq handler (car hlist))
  320.       (setq result (funcall handler))
  321.       (setq hlist (cdr hlist)))
  322.     (if (equal result t)
  323.     (progn
  324.       (if (not (equal (buffer-name) bn))
  325.           (rename-buffer bn))
  326.       (if (nth 0 mim)
  327.           (overwrite-mode 1)
  328.         (overwrite-mode 0))
  329.       (if (nth 1 mim)
  330.           (auto-fill-mode 1)
  331.         (overwrite-mode 0))
  332.       (goto-char pt)
  333.       (if (consp mk)
  334.           (progn
  335.         (set-mark (car mk))
  336.         (setq mark-active (car (cdr mk))))
  337.         (set-mark mk))
  338.       ;; Never override file system if the file really is read-only marked.
  339.       (if ro (setq buffer-read-only ro))
  340.       (setq truncate-lines tl)
  341.       (setq fill-column fc)
  342.       (setq case-fold-search cfs)
  343.       (setq case-replace cr)
  344.       ))))
  345. ;; ----------------------------------------------------------------------------
  346. (provide 'desktop)
  347.  
  348. ;; desktop.el ends here.
  349.  
  350.